COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	entry  sseg
C00016 ENDMK
C⊗;
entry  sseg;
begin   "sseg"

  comment    Programmed by K Ramesh Babu;

  require  "define.sai"  source!file;
  require  "grafix.dcl"  source!file;
  require  "bufdec.sai"  source!file;
  require  "seg.dcl"  source!file;

  define  apardata = "external";
  require  "apar.data"  source!file;
  require  "apar.dcl"  source!file;

  require "tenexio.sai" source!file;

    record!class  sseg(
    integer  name, first, noofseg, pr1, pr2, pc1, pc2;
    real  maxl, total);  define  sz = "8";
    define  sz1 = "9";
    record!pointer (sseg)  rp, wp, psseg;

  external  string  picture;
  string  s;

  safe  integer  array  header [0:hdrl-1];
  !  Header  information  in  .sseg files.;

    define  recsz = "header[2]",
            rowsz = "header[32]",
            colsz = "header[33]",
            ssegno = "header[34]";
    
  INTEGER  rfile, wfile, rrecsz, wrecsz;

  internal  simple  procedure  ssgreset(integer file);
  swdptr(file,hdrl);

  internal  simple  procedure  rssghdr;
  begin
    swdptr(rfile,0);  arryin(rfile,header[0],hdrl);
  end;

  internal  simple  procedure  ssgout;
  begin
  comment
  Outputs a supersegment onto a diskfile.;
    arryout(wfile,sseg:name[psseg],wrecsz);
  end;

  internal  simple  procedure  ssgin;
  begin
  comment
  Reads in a supersegment from a diskfile.;
    arryin(rfile,sseg:name[psseg],rrecsz);
  end;

  internal  simple  procedure  ssgrdopen;
  begin
  comment  Opens (s)sseg file(s) for reading.;
  integer  c;
    rfile := openfile(picture & ".sseg","roc");
    arryin(rfile,header[0],hdrl);
    psseg := new!record(sseg);
    rrecsz := recsz;
  end;

  internal  simple  procedure  ssgwtopen;
  begin
  comment
  Opens diskfiles for writing(only, I guess);
    wrecsz := sz1;
    psseg := new!record(sseg);
    wfile := openfile(picture & ".sseg","wc");
    swdptr(wfile,hdrl);
  end;


  internal  simple  procedure  ssgrclose;
  cfile(rfile);

  internal  simple  procedure  wssghdr;
  begin
  comment  Write headers onto (s)seg file(s).;
    header[0] :=  hdrl;          header[1] := 36;
    header[2] := wrecsz;         header[3] := wrecsz;
    header[4] := wrecsz * ssegno; header[5] := '1000001; 
    swdptr(wfile,0);  arryout(wfile,header[0],hdrl);
  end;

  internal  simple  procedure  ssgwclose;
  begin
    recsz := wrecsz;
    wssghdr;
    cfile(wfile);
  end;

  internal  simple  procedure  ssgtty;
  begin  "ssgtty"
  integer  ssno;
  comment
  This procedure types out contents of (s)segfiles, record by
  record. You give an integer as the id of the (super)segment
  and its attributes are typed out. If you give a number
  larger than the highest possible id, typing out loop is
  terminated.;

    print(" No of super segments: ",ssegno,crlf);
    ssno := 1;
    print(" Output on tty " & '77 & "[NO]: ");  s := intty;
    do  begin
      if  s = "Y" or s = "y"  then
      begin
        iprmpt(" Supersegment for display",ssno);
        swdptr(rfile,hdrl+(ssno-1)*rrecsz);  ssgin;
        print(" name: ",sseg:name[psseg], crlf);
        print(" first: ",sseg:first[psseg], crlf);
        print(" noofseg: ",sseg:noofseg[psseg], crlf);
        print(" pr1: ",sseg:pr1[psseg]);
        print(" pc1: ",sseg:Pc1[psseg]," to ");
        print(" pr2: ",sseg:pr2[psseg]);
        print(" pc2: ",sseg:pc2[psseg], crlf);
        print(" maxl: ",sseg:maxl[psseg], crlf);
        if  rrecsz = sz1  then
        begin
          print(" total: ",sseg:total[psseg],CRLF);
        end;
          SSNO := SSNO + 1;
      end;
      print(" Any more " & '77 & " [no]: ");  S := intty;
    end  until  not(s = "Y" or s = "y");
  end;  "sgtty"


  internal  procedure  ssegzoom;
  begin  "ssegzoom"

  boolean  more;
  integer  c;
    clipinit(rowsz,colsz);
    do  begin
      BEGINDISPLAY;
      ssgreset(rfile);
      FOR  c := 1 step 1 until ssegno  do
      begin
      integer  r1, c1, r2, c2;
        ssgin;
        r1 := sseg:pr1[psseg];  r2 := sseg:pr2[psseg];
        c1 := sseg:pc1[psseg];  c2 := sseg:pc2[psseg];
        clipdsp(r1,c1,r2,c2);
      end;
      legend(picture & ".sseg");
      endisplay;

      bprmpt(" Any more",more);
    end  until  not(more);
  
  end  "ssegzoom" ;

  internal  simple procedure  ssgrwopen;
  begin
  ! opens a supersegment file for updating (or, editing).
    Note: Old file is destroyed.;

    rfile := openfile(picture & ".sseg","rwo");
    wfile := rfile;  rrecsz := recsz;  wrecsz := recsz;
    psseg := new!record(sseg);
    arryin(rfile,header[0],hdrl);
  end;

  internal  simple procedure  mltotl;
  begin
  integer  c;  integer  f, n;  real  m;
  ! Procedure  to change the contents of .sseg file from maxl to
    total length of all constituent segments.;

    if  recsz = sz1  then
    begin
      print(" File already contains total lengths.",crlf);
      return;
    end;
    wrecsz := sz1;
    for  c := 1 step 1 until  ssegno  do
    begin
    integer  cc;
      ssgin;  f := sseg:first[psseg];  N := SSEG:noofseg[psseg];
      m := 0.0;
      FOR  cc := f step 1 until f+n  do
      begin
        m := m + seglen(cc);
      end;
      sseg:total[psseg] := M;
      ssgout;
    end;
  end;  "mltotl"

  internal  simple  procedure  ssginid(integer  ssegid);
  begin
    swdptr(rfile,hdrl+(ssegid-1)*rrecsz);  ssgin;
  end;

  INTERnal  simple  procedure  editheader;
  begin
    iprmpt(" record size",recsz);
    iprmpt(" row size of picture",rowsz);
    iprmpt(" col size of picture",colsz);
    iprmpt(" Total no of sseg",ssegno);
    wrecsz := recsz;
  end;

  internal  simple  procedure  segrange(integer  ssegid;
    reference  integer  segid1, segid2);
  begin
    swdptr(rfile,(ssegid-1)*rrecsz+hdrl);  ssgin;
    segid1 := sseg:first[psseg];
    segid2 := segid1 + sseg:noofseg[psseg] - 1;
  end;

  internal  simple  integer  procedure  nofssg;
  return(ssegno);

  internal  simple  procedure  ssgdep(integer  zn,zf,zns,zr1,zc1,zr2,zc2; real zml);
  begin
    sseg:name[psseg] := zn;
    sseg:first[psseg] := zf;
    sseg:noofseg[psseg] := zns;
    sseg:pr1[psseg] := zr1;
    sseg:pc1[psseg] := zc1;
    sseg:pr2[psseg] := zr2;
    sseg:pc2[psseg] := zc2;
    sseg:maxl[psseg] := zml;
    ssgout;
  end;

  internal  simple  procedure  deparms(integer s, r, c);
  begin
    ssegno := s;  rowsz := r;  colsz := c;
  end;

  internal  simple  procedure  ssegtofile(integer  chan);
  begin
    ssgin;
    cprint(chan," name: ",sseg:name[psseg], crlf);
    cprint(chan," first: ",sseg:first[psseg], crlf);
    cprint(chan," noofseg: ",sseg:noofseg[psseg], crlf);
    cprint(chan," pr1: ",sseg:pr1[psseg]);
    cprint(chan," pc1: ",sseg:Pc1[psseg]," to ");
    cprint(chan," pr2: ",sseg:pr2[psseg]);
    cprint(chan," pc2: ",sseg:pc2[psseg], crlf);
    cprint(chan," maxl: ",sseg:maxl[psseg], crlf);
    if  rrecsz = sz1  then
    begin
      cprint(chan," total: ",sseg:total[psseg],CRLF);
    end;
    cprint(chan,crlf,crlf);
  end;

  internal  simple  integer  procedure  noofsseg;
  return(ssegno);

  internal  simple  real  procedure  ssgmaxl(integer ssegid);
  begin
    ssginid(ssegid);
    return(sseg:maxl[psseg]);
  end;

end  "sseg"